home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Icon 8.1 / msm-1 / icont.sit / lsym.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-09-19  |  10.0 KB  |  438 lines  |  [TEXT/MPS ]
  1. /*
  2.  * lsym.c -- functions for symbol table manipulation.
  3.  */
  4.  
  5. #include "link.h"
  6. #include "tproto.h"
  7. #include "globals.h"
  8.  
  9. /*
  10.  * Prototypes.
  11.  */
  12.  
  13. hidden struct     fentry *alcfhead
  14.    Params((struct fentry *blink,word name, int fid, struct rentry *rlist));
  15. hidden struct     rentry *alcfrec    
  16.    Params((struct rentry *link,int rnum, int fnum));
  17. hidden struct     gentry *alcglobal
  18.    Params((struct gentry *blink, word name, int flag,int nargs,int procid));
  19. hidden struct     ientry *alcident    Params((char *nam,int len));
  20.  
  21. int dynoff;            /* stack offset counter for locals */
  22. int argoff;            /* stack offset counter for arguments */
  23. int static1;            /* first static in procedure */
  24. int lstatics = 0;        /* static variable counter */
  25.  
  26. int nlocal;            /* number of locals in local table */
  27. int nconst;            /* number of constants in constant table */
  28. int nfields = 0;        /* number of fields in field table */
  29.  
  30. /*
  31.  * instid - copy the string s to the start of the string free space
  32.  *  and call putident with the length of the string.
  33.  */
  34. word instid(s)
  35. char *s;
  36.    {
  37.    register int l;
  38.    register word indx;
  39.    register char *p;
  40.  
  41.    indx = lsfree;
  42.    p = s;
  43.    l = 0;
  44.    do {
  45.       if (indx >= stsize)
  46.          lsspace = (char *)trealloc(lsspace, NULL, &stsize, 1, 1,
  47.             "string space");
  48.       l++;
  49.       } while (lsspace[indx++] = *p++);
  50.    return putident(l);
  51.    }
  52.  
  53. /*
  54.  * putident - install the identifier named by the string starting at lsfree
  55.  *  and extending for len bytes.  The installation entails making an
  56.  *  entry in the identifier hash table and then making an identifier
  57.  *  table entry for it with alcident.  A side effect of installation
  58.  *  is the incrementing of lsfree by the length of the string, thus
  59.  *  "saving" it.
  60.  *
  61.  * Nothing is changed if the identifier has already been installed.
  62.  */
  63. word putident(len)
  64. int len;
  65.    {
  66.    register int hash;
  67.    register char *s;
  68.    register struct ientry *ip;
  69.    int l;
  70.  
  71.    /*
  72.     * Compute hash value by adding bytes and masking result with imask.
  73.     *  (Recall that imask is ihsize-1.)
  74.     */
  75.    s = &lsspace[lsfree];
  76.    hash = 0;
  77.    l = len;
  78.    while (l--)
  79.       hash += *s++;
  80.    l = len;
  81.    s = &lsspace[lsfree];
  82.    hash &= imask;
  83.    /*
  84.     * If the identifier hasn't been installed, install it.
  85.     */
  86.    if ((ip = lihash[hash]) != NULL) {     /* collision */
  87.       for (;;) { /* work down i_blink chain until id is found or the
  88.                      end of the chain is reached */
  89.          if (l == ip->i_length && lexeql(l, s, &lsspace[ip->i_name]))
  90.             return (ip->i_name); /* id is already installed, return it */
  91.          if (ip->i_blink == NULL) { /* end of chain */
  92.             ip->i_blink = alcident(s, l);
  93.             lsfree += l;
  94.             return ip->i_blink->i_name;
  95.             }
  96.          ip = ip->i_blink;
  97.          }
  98.       }
  99.    /*
  100.     * Hashed to an empty slot.
  101.     */
  102.    lihash[hash] = alcident(s, l);
  103.    lsfree += l;
  104.    return lihash[hash]->i_name;
  105.    }
  106.  
  107. /*
  108.  * lexeql - compare two strings of given length.  Returns non-zero if
  109.  *  equal, zero if not equal.
  110.  */
  111. int lexeql(l, s1, s2)
  112. register int l;
  113. register char *s1, *s2;
  114.    {
  115.    while (l--)
  116.       if (*s1++ != *s2++)
  117.          return 0;
  118.    return 1;
  119.    }
  120.  
  121. /*
  122.  * alcident - get the next free identifier table entry, and fill it in with
  123.  *  the specified values.
  124.  */
  125. static struct ientry *alcident(nam, len)
  126. char *nam;
  127. int len;
  128.    {
  129.    register struct ientry *ip;
  130.  
  131.    ip = NewStruct(ientry);
  132.    ip->i_blink = NULL;
  133.    ip->i_name = (word)(nam - lsspace);
  134.    ip->i_length = len;
  135.    return ip;
  136.    }
  137.  
  138. /*
  139.  * locinit -  clear local symbol table.
  140.  */
  141. novalue locinit()
  142.    {
  143.    dynoff = 0;
  144.    argoff = 0;
  145.    nlocal = -1;
  146.    nconst = -1;
  147.    static1 = lstatics;
  148.    }
  149.  
  150. /*
  151.  * putlocal - make a local symbol table entry.
  152.  */
  153. novalue putlocal(n, id, flags, imperror, procname)
  154. int n;
  155. word id;
  156. register int flags;
  157. int imperror;
  158. word procname;
  159.    {
  160.    register struct lentry *lp;
  161.    union {
  162.       struct gentry *gp;
  163.       int bn;
  164.       } p;
  165.  
  166.    if (n >= lsize)
  167.       lltable  = (struct lentry *) trealloc(lltable, NULL, &lsize,
  168.          sizeof(struct lentry), 1, "local symbol table");
  169.    if (n > nlocal)
  170.       nlocal = n;
  171.    lp = &lltable[n];
  172.    lp->l_name = id;
  173.    lp->l_flag = flags;
  174.    if (flags == 0) {                /* undeclared */
  175.       if ((p.gp = glocate(id)) != NULL) {    /* check global */
  176.          lp->l_flag = F_Global;
  177.          lp->l_val.global = p.gp;
  178.          }
  179.  
  180. #ifdef Xver
  181. xver(lsym.1)
  182. #else                    /* Xver */
  183.       else if ((p.bn = blocate(id)) != 0) {    /* check for function */
  184.          lp->l_flag = F_Builtin;
  185.          lp->l_val.global = putglobal(id, F_Builtin | F_Proc, -1, p.bn);
  186.          }
  187. #endif                    /* Xver */
  188.  
  189.       else {                    /* implicit local */
  190.          if (imperror)
  191.             lwarn(&lsspace[id], "undeclared identifier, procedure ", 
  192.                &lsspace[procname]);
  193.          lp->l_flag = F_Dynamic;
  194.          lp->l_val.offset = ++dynoff;
  195.          }
  196.       }
  197.    else if (flags & F_Global) {            /* global variable */
  198.       if ((p.gp = glocate(id)) == NULL)
  199.          quit("putlocal: global not in global table");
  200.       lp->l_val.global = p.gp;
  201.       }
  202.    else if (flags & F_Argument)            /* procedure argument */
  203.       lp->l_val.offset = ++argoff;
  204.    else if (flags & F_Dynamic)            /* local dynamic */
  205.       lp->l_val.offset = ++dynoff;
  206.    else if (flags & F_Static)            /* local static */
  207.       lp->l_val.staticid = ++lstatics;
  208.    else
  209.       quit("putlocal: unknown flags");
  210.    }
  211.  
  212. /*
  213.  * putglobal - make a global symbol table entry.
  214.  */
  215. struct gentry *putglobal(id, flags, nargs, procid)
  216. word id;
  217. int flags;
  218. int nargs;
  219. int procid;
  220.    {
  221.    register struct gentry *p;
  222.  
  223.    if ((p = glocate(id)) == NULL) {    /* add to head of hash chain */
  224.       p = lghash[ghasher(id)];
  225.       lghash[ghasher(id)] = alcglobal(p, id, flags, nargs, procid);
  226.       return lghash[ghasher(id)];
  227.       }
  228.    p->g_flag |= flags;
  229.    p->g_nargs = nargs;
  230.    p->g_procid = procid;
  231.    return p;
  232.    }
  233.  
  234. /*
  235.  * putconst - make a constant symbol table entry.
  236.  */
  237. novalue putconst(n, flags, len, pc, valp)
  238. int n;
  239. int flags, len;
  240. word pc;
  241. union xval *valp;
  242.  
  243.    {
  244.    register struct centry *p;
  245.    if (n >= csize)
  246.       lctable  = (struct centry *) trealloc(lctable, NULL, &csize,
  247.          sizeof(struct centry), 1, "constant table");
  248.    if (nconst < n)
  249.       nconst = n;
  250.    p = &lctable[n];
  251.    p->c_flag = flags;
  252.    p->c_pc = pc;
  253.    if (flags & F_IntLit) {
  254.       p->c_val.ival = valp->ival;
  255.       }
  256.    else if (flags & F_StrLit) {
  257.       p->c_val.sval = valp->sval;
  258.       p->c_length = len;
  259.       }
  260.    else if (flags & F_CsetLit) {
  261.       p->c_val.sval = valp->sval;
  262.       p->c_length = len;
  263.       }
  264.    else    if (flags & F_RealLit)
  265.  
  266. #ifdef Double
  267. /* access real values one word at a time */
  268.     {  int *rp, *rq;    
  269.        rp = (int *) &(p->c_val.rval);
  270.        rq = (int *) &(valp->rval);
  271.        *rp++ = *rq++;
  272.        *rp   = *rq;
  273.     }
  274. #else                    /* Double */
  275.       p->c_val.rval = valp->rval;
  276. #endif                    /* Double */
  277.  
  278.    else
  279.       fprintf(stderr, "putconst: bad flags: %06o %011lo\n", flags, valp->ival);
  280.    }
  281.  
  282. /*
  283.  * putfield - make a record/field table entry.
  284.  */
  285. novalue putfield(fname, rnum, fnum)
  286. word fname;
  287. int rnum, fnum;
  288.    {
  289.    register struct fentry *fp;
  290.    register struct rentry *rp, *rp2;
  291.    word hash;
  292.  
  293.    fp = flocate(fname);
  294.    if (fp == NULL) {        /* create a field entry */
  295.       nfields++;
  296.       hash = fhasher(fname);
  297.       fp = lfhash[hash];
  298.       lfhash[hash] = alcfhead(fp, fname, nfields, alcfrec((struct rentry *)NULL,
  299.          rnum, fnum));
  300.       return;
  301.       }
  302.    rp = fp->f_rlist;        /* found field entry, look for */
  303.    if (rp->r_recid > rnum) {    /*   spot in record list */
  304.       fp->f_rlist = alcfrec(rp, rnum, fnum);
  305.       return;
  306.       }
  307.    while (rp->r_recid < rnum) {    /* keep record list ascending */
  308.       if (rp->r_link == NULL) {
  309.          rp->r_link = alcfrec((struct rentry *)NULL, rnum, fnum);
  310.          return;
  311.          }
  312.       rp2 = rp;
  313.       rp = rp->r_link;
  314.       }
  315.    rp2->r_link = alcfrec(rp, rnum, fnum);
  316.    }
  317.  
  318. /*
  319.  * glocate - lookup identifier in global symbol table, return NULL
  320.  *  if not present.
  321.  */
  322. struct gentry *glocate(id)
  323. word id;
  324.    {
  325.    register struct gentry *p;
  326.  
  327.    p = lghash[ghasher(id)];
  328.    while (p != NULL && p->g_name != id)
  329.       p = p->g_blink;
  330.    return p;
  331.    }
  332.  
  333. /*
  334.  * flocate - lookup identifier in field table.
  335.  */
  336. struct fentry *flocate(id)
  337. word id;
  338.    {
  339.    register struct fentry *p;
  340.  
  341.    p = lfhash[fhasher(id)];
  342.    while (p != NULL && p->f_name != id)
  343.       p = p->f_blink;
  344.    return p;
  345.    }
  346.  
  347. /*
  348.  * alcglobal - create a new global symbol table entry.
  349.  */
  350. static struct gentry *alcglobal(blink, name, flag, nargs, procid)
  351. struct gentry *blink;
  352. word name;
  353. int flag;
  354. int nargs;
  355. int procid;
  356.    {
  357.    register struct gentry *gp;
  358.  
  359.    gp = NewStruct(gentry);
  360.    gp->g_blink = blink;
  361.    gp->g_name = name;
  362.    gp->g_flag = flag;
  363.    gp->g_nargs = nargs;
  364.    gp->g_procid = procid;
  365.    gp->g_next = NULL;
  366.    if (lgfirst == NULL) {
  367.       lgfirst = gp;
  368.       gp->g_index = 0;
  369.       }
  370.    else {
  371.       lglast->g_next = gp;
  372.       gp->g_index = lglast->g_index + 1;
  373.       }
  374.    lglast = gp;
  375.    return gp;
  376.    }
  377.  
  378. /*
  379.  * alcfhead - allocate a field table header.
  380.  */
  381. static struct fentry *alcfhead(blink, name, fid, rlist)
  382. struct fentry *blink;
  383. word name;
  384. int fid;
  385. struct rentry *rlist;
  386.    {
  387.    register struct fentry *fp;
  388.  
  389.    fp = NewStruct(fentry);
  390.    fp->f_blink = blink;
  391.    fp->f_name = name;
  392.    fp->f_fid = fid;
  393.    fp->f_rlist = rlist;
  394.    fp->f_nextentry = NULL;
  395.    if (lffirst == NULL)
  396.       lffirst = fp;
  397.    else
  398.       lflast->f_nextentry = fp;
  399.    lflast = fp;
  400.    return fp;
  401.    }
  402.  
  403. /*
  404.  * alcfrec - allocate a field table record list element.
  405.  */
  406. static struct rentry *alcfrec(link, rnum, fnum)
  407. struct rentry *link;
  408. int rnum, fnum;
  409.    {
  410.    register struct rentry *rp;
  411.  
  412.    rp = NewStruct(rentry);
  413.    rp->r_link = link;
  414.    rp->r_recid = rnum;
  415.    rp->r_fnum = fnum;
  416.    return rp;
  417.    }
  418.  
  419. /*
  420.  * blocate - search for a function. The search is linear to make
  421.  *  it easier to add/delete functions. If found, returns index+1 for entry.
  422.  */
  423.  
  424. int blocate(s_indx)
  425. word s_indx;
  426.    {
  427. register char *s;
  428.    register int i;
  429.    extern char *ftable[];
  430.    extern int ftbsize;
  431.  
  432.    s = &lsspace[s_indx];
  433.    for (i = 0; i < ftbsize; i++)
  434.       if (strcmp(ftable[i], s) == 0)
  435.      return i + 1;
  436.    return 0;
  437.    }
  438.